#!/bin/env perl

#
# Dependencies.
#

use Getopt::Long;
use HTTP::Headers;
use JSON qw( decode_json encode_json );
use List::MoreUtils qw( all uniq );
use LWP::UserAgent;
use MIME::Lite;
use Sort::Naturally qw( nsort );
use YAML qw( Dump );

#
# Uses.
#

use strict;
use warnings;

#
# Options.
#

my @required = qw( repository_kind repository_id repository_path revision host port hash smtp from root );

my %option;

GetOptions ( \%option, qw{
  repository_path=s
  repository_id=s
  repository_kind=s
  revision=s
  
  svnlook=s
  strip_changed=s
  
  host=s
  port=s
  hash=s
  
  smtp=s
  from=s
  root=s
  
  mail
  push
  
  debug
  dummy
  test
  trace
} ) and ( all { defined $option{$_} } @required )
  or die 'Usage: isock_svn_post_commit_hook --repository_kind=<datasheet|specification> --repository_id=$id --repository=$path --revision=$integer --host=$host --port=$port --hash=$hash --smtp=$smtp --from=$from --root=$root [--mail] [--push] [--svnlook=$svnlook] [--dummy] [--debug] [--test] [--trace]';

#
# Constants.
#

my $what = 'application/json';
my $curl = "curl --proxy '' --header 'Accept: $what'";

#
# Variables.
#

my $repository_id   = $option{repository_id};
my $repository_path = $option{repository_path};
my $revision        = $option{revision};
my $kind            = $option{repository_kind};
my $host            = $option{host};
my $port            = $option{port};
my $hash            = $option{hash};
my $smtp            = $option{smtp};
my $from            = $option{from};
my $root            = $option{root};
my $dummy           = $option{dummy} || $ENV{ISOCK_DUMMY};
my $debug           = $option{debug} || $ENV{ISOCK_DEBUG};
my $test            = $option{test}  || $ENV{ISOCK_TEST};
my $trace           = $option{trace} || $ENV{ISOCK_TRACE};

my $rest            = "http://$host:$port/rest";
my $tail            = "hash=$hash" . ( $dummy ? "&dummy=1" : "" ) . ( $test ? "&test=1" : "" ) . ( $debug ? "&debug=1" : "" );

#
# Look.
#

my $look = svnlook ( $revision, $repository_path );

my ( $author, $timestamp, $size, $message ) = map { $look->{$_} } qw( author timestamp size message );

my @changes  = @{$look->{changes}};
my @projects = projects ( @changes );

my $subject  = "[subversion] post-commit $kind revision $revision (" . join ( ", ", @projects ) .")";

if ( $dummy ) {
  print STDERR "# Changes:\n";
  print STDERR Dump ( \@changes );
  print STDERR "# Projects:\n";
  print STDERR Dump ( \@projects );
}

#
# Agent.
#

my $ua = LWP::UserAgent->new;

$ua->no_proxy ( $host );
$ua->timeout ( 10 * 60 );

#
# Push (DB).
#

if ( $option{push} ) {
  my @pushes = pushes ( $kind => @changes );
  
  if ( $dummy || $test ) {
    print STDERR "# To be pushed:\n";
    print STDERR Dump ( \@pushes );
  }
  
  for my $push ( @pushes ) {
    my ( $id, $tag, $branch );

    if    ( ( $id, $tag    ) = ( $push =~ /^ ( [^=]+) \s+  = \s+ ( [^=]+) $/x ) ) {
    }
    elsif ( ( $id, $branch ) = ( $push =~ /^ ([^\>]+) \s+ \> \s+ ([^\>]+) $/x ) ) {
    }
    else {
      $id = $push;
    }

    my $url = "$rest/$kind/$id?repository_id=$repository_id&$tail";

    if ( $tag ) {
      $url .= "&tag=$tag";
    }
    elsif ( $branch ) {
      $url .= "&branch=$branch";
    }

    my $isock_restful_query = "isock_restful_query --put --$kind $id" . ( $tag ? " --tag $tag" : "" ) . ( $branch ? " --branch $branch" : "" ) . " --repository_id $repository_id";

    if ( $dummy ) {
      print STDERR "# $isock_restful_query --hash $hash --dummy\n";
      print STDERR "#   PUT '$url'\n";
      print STDERR "#   $curl --request PUT --url ...\n";
    }
    else {
      my $request  = HTTP::Request->new ( PUT => $url, HTTP::Headers->new ( Accept => $what ) );
      my $response = $ua->request ( $request );

      unless ( $response->is_success ) {
        report ( ERROR =>
          "Could not PUT to '$url' URL!\n"
        . "Hotfixes:\n"
        . "  - $curl --request PUT --url '$url'\n"
        . "  - $isock_restful_query\n"
        . $response->status_line
        );
      }
    }
  }
}
  
#
# Mail.
#

if ( $option{mail} ) {
  my $url  = "$rest/commit?repository_id=$repository_id&$tail";
  my $json = encode_json ( $look );

  if ( my $request = HTTP::Request->new ( POST => $url, HTTP::Headers->new ( Accept => $what ), $json ) ) {
    my $response = $ua->request ( $request );

    if ( $response->is_success ) {
      print STDERR Dump ( decode_json ( $response->content ) );
    }
    else {
      report ( ERROR =>
        "Could not POST to '$url' URL (\"" . $response->status_line . "\")!\n"
      . "Hotfix: $curl --request POST --url '$url' --data '$json'"
      );
    }
  }
}

#
# Push (DB & CI).
#

if ( $option{push} ) {
  if ( $kind eq 'specification' ) {
    for my $project ( @projects ) {
      my   $mif_changed_on_trunk    = grep {            $_ =~ / $project \/ trunk    \/             specification \/ $project \.mif /x } @changes;
      my   $xls_changed_on_trunk    = grep {            $_ =~ / $project \/ trunk    \/             followup      \/ $project \.xls /x } @changes;
      
      my ( $mif_changed_on_branch ) = grep { defined } map { m/ $project \/ branches \/ ([^\/]+) \/ specification \/ $project \.mif /x ? $1 : undef } @changes;
      my ( $xls_changed_on_branch ) = grep { defined } map { m/ $project \/ branches \/ ([^\/]+) \/ followup      \/ $project \.mif /x ? $1 : undef } @changes;
      
      # FIXME report if both changed_on_trunk and changed_on_branch
      
      my   $electrical_changed      = grep {            $_ =~ / $project \/ trunk    \/             snippets      \/ include \/ electrical \. h                         /x } @changes;
      my   $system_changed          = grep {            $_ =~ / $project \/ trunk    \/             snippets      \/ source  \/ system     \. c                         /x } @changes;
      my   $loader_changed          = grep {            $_ =~ / $project \/ trunk    \/             snippets      \/ loader  \/ flash      \. (?: board | flash | out ) /x } @changes;
      
      my $specification_changed     = $mif_changed_on_trunk || defined $mif_changed_on_branch || $xls_changed_on_trunk || defined $xls_changed_on_branch;
      my $snippets_changed          = $electrical_changed || $system_changed || $loader_changed;
      
      if ( $trace ) {
        report ( TRACE =>
          "mif_changed_on_trunk  : $mif_changed_on_trunk\n"
        . "xls_changed_on_trunk  : $xls_changed_on_trunk\n"
        . "---------------------\n"
        . "specification_changed : $specification_changed\n"
        . "\n"
        . "electrical_changed    : $electrical_changed\n"
        . "system_changed        : $system_changed\n"
        . "loader_changed        : $loader_changed\n"
        . "---------------------\n"
        . "snippets_changed      : $snippets_changed\n"
        );
      }
      
      #
      # DB.
      #
      
      if ( $specification_changed ) {
        $tail .= defined $mif_changed_on_branch ? "&branch=$mif_changed_on_branch" : "";
        
        my $url = "$rest/specification/$project/pull?$tail";
        
        if ( $dummy && !$test ) {
          print STDERR "# isock_restful_query --specification $project --pull --hash $hash --dummy\n";
          print STDERR "#   PUT '$url'\n";
          print STDERR "#   $curl --request PUT --url ...\n";
        }
        else {
          put_request ( $ua => $url );
        }
      }
      
      #
      # CI.
      #
      
      if ( $specification_changed || $snippets_changed ) {
        $tail .= "&author=$look->{author}&revision=$look->{revision}";
        $tail .= defined $mif_changed_on_branch ? "&branch=$mif_changed_on_branch" : "";
        $tail .= defined $xls_changed_on_branch ? "&branch=$xls_changed_on_branch" : "" unless $tail =~ / \b branch = \b/x;
        
        my $url = "$rest/specification/$project/integrate?$tail";
        
        if ( $dummy && !$test ) {
          print STDERR "# isock_restful_query --specification $project --integrate --hash $hash --dummy\n";
          print STDERR "#   PUT '$url'\n";
          print STDERR "#   $curl --request PUT --url ...\n";
        }
        else {
          put_request ( $ua => $url );
        }
      }
    }
  }
}

#
# Subs.
#

sub pushes {
  my ( $kind, @changes ) = @_;
  
  my ( $whatever_re, $tag_re, $branch_re );
  
  if ( $kind eq 'datasheet' ) {
    $whatever_re = qr/^ [AU] \s+ ( [A-Z][A-Z0-9]+ _ \d+ ) \/                             /x;
    $tag_re      = qr/^  A   \s+ ( [A-Z][A-Z0-9]+ _ \d+ ) \/ tags     \/ ( [A-Z]  )  \/ $/x;
    $branch_re   = qr/^  A   \s+ ( [A-Z][A-Z0-9]+ _ \d+ ) \/ branches \/ ( [A-Z]  )  \/ $/x;
  }
  else {
    $whatever_re = qr/^ [AU] \s+ ( [^\/]+               ) \/                             /x;
    $tag_re      = qr/^  A   \s+ ( [^\/]+               ) \/ tags     \/ ( [^\/]+ )  \/ $/x;
    $branch_re   = qr/^  A   \s+ ( [^\/]+               ) \/ branches \/ ( [^\/]+ )  \/ $/x;
  }
  
  my @pushes;
  
  for my $change ( @changes ) {
    if    ( $change =~ $tag_re      ) {
      push @pushes, "$1 = $2";
    }
    elsif ( $change =~ $branch_re   ) {
      push @pushes, "$1 > $2";
    }
    elsif ( $change =~ $whatever_re ) {
      push @pushes, "$1";
    }
  }
  
  return uniq sort @pushes;
}

sub projects {
  my ( @changes ) = @_;
  
  my $project_h;
     $project_h->{$_} = 1 for map { m/ \s+ ([^\/]+) \/ /x ; $1 } @changes;

  return nsort keys %$project_h;
}

sub svnlook {
  my ( $revision, $repository_path ) = @_;
  
  my $svnlook = $option{svnlook} || 'svnlook';

  my ( $author, $timestamp, $size, $message );

  {
    open my $fh, "$svnlook info --revision $revision $repository_path |" or die "Could not invoke $svnlook info: $!";

    while ( <$fh> ) {
      $author    = $_, next unless $author;
      $timestamp = $_, next unless $timestamp;
      $size      = $_, next unless $size;

      $message  .= $_  if $author && $timestamp && $size;
    }

    chomp $author;
    chomp $timestamp;
    chomp $size;
    chomp $message;
  }
  
  my $look = { revision => $revision, author => $author, timestamp => $timestamp, size => $size, message => $message };
  
  {
    open my $fh, "$svnlook changed --revision $revision $repository_path |" or die "Could not invoke $svnlook changed: $!";
    
    my $strip = $option{strip_changed};

    $look->{changes} = [ map { chomp ; s/$strip//x if $strip ; $_ } <$fh> ];
  }
  
  return $look;
}

sub put_request {
  my ( $ua, $url ) = @_;
  
  my $request  = HTTP::Request->new ( PUT => $url, HTTP::Headers->new ( Accept => $what ) );
  my $response = $ua->request ( $request );

  unless ( $response->is_success ) {
    my ( $specification, $action ) = ( $url =~ / \/ ([^\/]+) \/ (pull|integrate) \? /x );
    
    report ( ERROR =>
      "Could not PUT to '$url' URL!\n"
    . "Hotfixes:\n"
    . "  - $curl --request PUT --url '$url'\n"
    . "  - isock_restful_query --specification $specification --$action --put\n"
    . "Status: " . $response->status_line
    );
  }
}

sub report {
  my ( $status, $message ) = @_;
  
  my $mime = MIME::Lite->new (
    From    => $from,
    To      => $root,
    Subject => "$subject [$status]",
    Type    => 'TEXT',
    Data    => $message,
  );

  $mime->send ( smtp => $smtp, Debug => $debug ) or die "problem with '$smtp' server while reporting '$message'";
}
